home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / lang / small304.lha / Smalltalk / src / mult.st < prev    next >
Text File  |  1989-03-30  |  3KB  |  153 lines
  1. *
  2. * Little Smalltalk, version 3
  3. * Written by Tim Budd, Oregon State University, July 1988
  4. *
  5. * multiprocess scheduler 
  6. *
  7. * if event driven interface (stdwin) is used the event manager sits
  8. *  below the multiprocess scheduler
  9. *
  10. Class Process Object stack stackTop linkPointer
  11. Class Scheduler Object notdone processList currentProcess
  12. Class Semaphore Object count processList
  13. Methods Block 'forks'
  14.     newProcess 
  15.         " create a new process to execute block "
  16.         ^ Process new; context: context ; startAt: bytePointer.
  17. |
  18.     newProcessWith: args
  19.         (self checkArgumentCount: args size)
  20.             ifTrue: [ (1 to: args size) do: [:i |
  21.                    context at: (argLoc + i - 1) 
  22.                     put: (args at: i)]].
  23.         ^ self newProcess
  24. |
  25.     fork
  26.         self newProcess resume
  27. |
  28.     forkWith: args
  29.         (self newProcessWith: args) resume
  30. ]
  31. Methods Process 'all'
  32.     execute 
  33.         " execute for time slice, terminating if all over "
  34.         (stack size > 1500)
  35.             ifTrue: [ smalltalk error:
  36.                 'process stack overflow, probable loop'].
  37.         <19 self> ifTrue: [] ifFalse: [ self terminate ].
  38. |
  39.     context
  40.         ^ stack at: 3
  41. |
  42.     resume
  43.         " resume current process "
  44.         scheduler addProcess: self
  45. |
  46.     terminate
  47.         " kill current process "
  48.         scheduler removeProcess: self. scheduler yield.
  49. |
  50.     trace        | link m r s |
  51.         " first yield scheduler, forceing store of linkPointer"
  52.         scheduler yield.
  53.         link <- linkPointer.
  54.         link <- stack at: link+1.
  55.         " then trace back chain "
  56.         [ link notNil ] whileTrue:
  57.             [ m <- stack at: link+3. 
  58.               m notNil 
  59.                 ifTrue: [ s <- m signature, ' ('.
  60.                         r <- stack at: link+2.
  61.                         (r to: link-1) do: 
  62.                         [:x | s <- s, ' ', 
  63.                             (stack at: x) class asString].
  64.                       (s, ')') print ].
  65.               link <- stack at: link ]
  66. ]
  67. Methods Scheduler 'all'
  68.     new
  69.         "create a new scheduler with empty process list "
  70.         notdone <- true.
  71.         processList <- Set new.
  72. |
  73.     addProcess: aProcess
  74.         " add a process to the process list "
  75.         processList add: aProcess
  76. |
  77.     critical: aBlock
  78.         "set time slice counter high to insure bytecodes are
  79.         executed before continuing "
  80.         <53 10000>.
  81.         aBlock value.
  82.         "then yield processor "
  83.         <53 0>.
  84. |
  85.     currentProcess
  86.         " return the currently executing process "
  87.         ^ currentProcess
  88. |
  89.     removeProcess: aProcess
  90.         " remove a given process from the process list "
  91.         processList remove: aProcess.
  92. |
  93.     run
  94.         " run as long as process list is non empty "
  95.         [ notdone ] whileTrue:
  96.             [ processList size = 0 ifTrue: 
  97.                 [ self initialize ].
  98.               processList do: 
  99.                 [ :x | currentProcess <- x.
  100.                     x execute  ] ]
  101. |
  102.     yield
  103.         " set time slice counter to zero, thereby
  104.         yielding to next process "
  105.         <53 0>
  106. ]
  107. Methods Process 'creation'
  108.     new
  109.         stack <- Array new: 50.
  110.         stackTop <- 10.
  111.         linkPointer <- 2.
  112.         stack at: 4 put: 1. "return point"
  113.         stack at: 6 put: 1. "bytecode counter"
  114. |
  115.     method: x 
  116.         stack at: 5 put: x.
  117. |
  118.     context: ctx
  119.         stack at: 3 put: ctx.
  120. |
  121.     startAt: x
  122.         stack at: 6 put: x. "starting bytecode value"
  123. ]
  124. Methods Semaphore 'all'
  125.     new
  126.         count <- 0.
  127.         processList <- List new
  128. |
  129.     critical: aBlock
  130.         self wait.
  131.         aBlock value.
  132.         self signal
  133. |
  134.     set: aNumber
  135.         count <- aNumber
  136. |
  137.     signal
  138.         (processList size = 0)
  139.             ifTrue: [ count <- count + 1]
  140.             ifFalse: [ scheduler critical:
  141.                 [ processList first resume.
  142.                     processList removeFirst ]]
  143. |
  144.     wait        | process |
  145.         (count = 0)
  146.             ifTrue: [ scheduler critical:
  147.                     [ process <- scheduler currentProcess.
  148.                       processList add: process.
  149.                       scheduler removeProcess: process].
  150.                   scheduler yield ]
  151.             ifFalse: [ count <- count - 1]
  152. ]
  153.